## ---------------------------
##
## Project: MA Thesis
##
## Purpose of script: Helper functions for the Analysis of the Conjoint Experimental Data
##
## Author: Markus Freitag
##
##
## 
## ---------------------------
##
## Notes:
##   
##
## ---------------------------


## ---------------------------
##
## Project: MA Thesis
##
## Purpose of script: Helper functions for the Analysis of the Conjoint Experimental Data
##
## Author: Markus Freitag
##
##
## 
## ---------------------------
##
## Notes:
##   
##
## ---------------------------

#' @export 
conjoint_reshape <- function(df) {

  box::use(dplyr[...], tidyr[pivot_longer, pivot_wider, separate], data.table[setDT])
   
  cj_tidy <- df %>% 
    pivot_longer(cols = matches("CJ.ATT.CH."), names_to = "name", values_to = "value") %>% 
    separate(name, into = c("CJ", "ATT", "CH"), sep = c(3,7)) %>% 
    mutate(y = case_when(CJ == "CJ1" ~ Q15A1r1,
                        CJ == "CJ2" ~ Q15A2r1,
                        CJ == "CJ3" ~ Q15A3r1,
                        CJ == "CJ4" ~ Q15A4r1,
                        CJ == "CJ5" ~ Q15A5r1,
                        CJ == "CJ6" ~ Q15A6r1)) %>% 
    mutate(timer = case_when(CJ == "CJ1" ~ CJ_1_timer,
                            CJ == "CJ2" ~ CJ_2_timer,
                            CJ == "CJ3" ~ CJ_3_timer,
                            CJ == "CJ4" ~ CJ_4_timer,
                            CJ == "CJ5" ~ CJ_5_timer,
                            CJ == "CJ6" ~ CJ_6_timer)) %>% 
    mutate(y_rating = case_when(CJ == "CJ1" & CH == "CH1" ~ Q15B1r1,
                                CJ == "CJ1" & CH == "CH2" ~ Q15B1r2,
                                CJ == "CJ2" & CH == "CH1" ~ Q15B2r1,
                                CJ == "CJ2" & CH == "CH2" ~ Q15B2r2,
                                CJ == "CJ3" & CH == "CH1" ~ Q15B3r1,
                                CJ == "CJ3" & CH == "CH2" ~ Q15B3r2,
                                CJ == "CJ4" & CH == "CH1" ~ Q15B4r1,
                                CJ == "CJ4" & CH == "CH2" ~ Q15B4r2,
                                CJ == "CJ5" & CH == "CH1" ~ Q15B5r1,
                                CJ == "CJ5" & CH == "CH2" ~ Q15B5r2,
                                CJ == "CJ6" & CH == "CH1" ~ Q15B6r1,
                                CJ == "CJ6" & CH == "CH2" ~ Q15B6r2,
    )) %>% 
    pivot_wider(names_from = ATT, values_from = value) %>% 
    select(uuid, CH, CJ, y, y_rating, timer, ATT1, ATT2, ATT3, ATT4, ATT5, ATT6, ATT7, ATT8, ATT9, everything()) %>% 
    mutate(y = ifelse(CH == "CH1" & y == 1 | CH == "CH2" & y == 2, 1,0)) # generate binary outcome


  ### Transform attributes and levels to factor

  cj_tidy  <- setDT(cj_tidy)
  attr_names <- c("ATT1","ATT2", "ATT3", "ATT4", "ATT5", "ATT6", "ATT7", "ATT8", "ATT9")
  cj_tidy  <- cj_tidy[, (attr_names):= lapply(.SD, factor), .SDcols= attr_names] 
  sapply(cj_tidy, is.factor)


  ### Labelling the levels

  levels(cj_tidy$ATT1)[levels(cj_tidy$ATT1)=="1"] <- "Democratically elected"
  levels(cj_tidy$ATT1)[levels(cj_tidy$ATT1)=="2"] <- "Not democratically elected"

  levels(cj_tidy$ATT2)[levels(cj_tidy$ATT2)=="1"] <- "Human rights respected"
  levels(cj_tidy$ATT2)[levels(cj_tidy$ATT2)=="2"] <- "Freedom of expression suppressed"
  levels(cj_tidy$ATT2)[levels(cj_tidy$ATT2)=="3"] <- "Dissidents persecuted/incarcerated/tortured"


  levels(cj_tidy$ATT3)[levels(cj_tidy$ATT3)=="1"] <- "Peace in the country"
  levels(cj_tidy$ATT3)[levels(cj_tidy$ATT3)=="2"] <- "Conflict with terrorists"
  levels(cj_tidy$ATT3)[levels(cj_tidy$ATT3)=="3"] <- "Civil war with rebels"
  levels(cj_tidy$ATT3)[levels(cj_tidy$ATT3)=="4"] <- "Country at war, under attack"
  levels(cj_tidy$ATT3)[levels(cj_tidy$ATT3)=="5"] <- "Country at war, attacks"

  levels(cj_tidy$ATT4)[levels(cj_tidy$ATT4)=="1"] <- "Important partner"
  levels(cj_tidy$ATT4)[levels(cj_tidy$ATT4)=="2"] <- "Not an important partner"

  levels(cj_tidy$ATT5)[levels(cj_tidy$ATT5)=="1"] <- "A lot of trade of goods"
  levels(cj_tidy$ATT5)[levels(cj_tidy$ATT5)=="2"] <- "Little trade of goods"

  levels(cj_tidy$ATT6)[levels(cj_tidy$ATT6)=="1"] <- "1 m"
  levels(cj_tidy$ATT6)[levels(cj_tidy$ATT6)=="2"] <- "10 m"
  levels(cj_tidy$ATT6)[levels(cj_tidy$ATT6)=="3"] <- "100 m"
  levels(cj_tidy$ATT6)[levels(cj_tidy$ATT6)=="4"] <- "1000 m (1 bn)"

  levels(cj_tidy$ATT7)[levels(cj_tidy$ATT7)=="1"] <- "100"
  levels(cj_tidy$ATT7)[levels(cj_tidy$ATT7)=="2"] <- "1000"
  levels(cj_tidy$ATT7)[levels(cj_tidy$ATT7)=="3"] <- "5000"


  levels(cj_tidy$ATT8)[levels(cj_tidy$ATT8)=="1"] <- "Military protective equipment"
  levels(cj_tidy$ATT8)[levels(cj_tidy$ATT8)=="2"] <- "Small arms (e.g. rifles, pistols)"
  levels(cj_tidy$ATT8)[levels(cj_tidy$ATT8)=="3"] <- "Large weapons (e.g. tanks, aircraft, ships)"
  levels(cj_tidy$ATT8)[levels(cj_tidy$ATT8)=="4"] <- "Military reconnaissance and surveillance systems"

  levels(cj_tidy$ATT9)[levels(cj_tidy$ATT9)=="1"] <- "Unknown"
  levels(cj_tidy$ATT9)[levels(cj_tidy$ATT9)=="2"] <- "{France/Germany}"
  levels(cj_tidy$ATT9)[levels(cj_tidy$ATT9)=="3"] <- "China and Russia"
  levels(cj_tidy$ATT9)[levels(cj_tidy$ATT9)=="4"] <- "NATO partners (USA, UK, {France/Germany})"

  return(cj_tidy)
}





#' @export 
format_acp <- function(df = NULL, name = NULL) {
  
  box::use(stringr[str_extract], stats[pnorm], dplyr[...])
  
  estimates <- df$estimates
  se        <- sqrt(diag(df$vcov))
  z <- estimates/se
  
  out_table <- data.frame(term = gsub("ATT[1-9].", "", names(estimates)),
                          attribute     = as.factor(str_extract(names(estimates), ".+?(?=\\.)")),
                          estimate = estimates,
                          se       = se,
                          z = z,
                          p =  2*pnorm(abs(estimates/se), lower.tail = FALSE),
                          conf.low =  estimates - 1.96 * se, 
                          conf.high = estimates + 1.96 * se)
  
  out_table <- out_table%>% 
    group_by(attribute)  %>% 
    arrange(estimate, .by_group = TRUE) %>% 
    ungroup() %>% 
    mutate(order = row_number()*-1) 
  
  out_table$order <- factor(out_table$order)
  
  out_table
  
}

#' @export 
plexi <- function(...) {
  box::use(ggplot2[...])

  theme_minimal() +
  theme(
    text = element_text(family = "CMU Serif", size = 12, colour="black"),
    panel.background = element_rect(fill = "white", colour = NA),
    panel.border     = element_rect(fill = NA, colour = "grey20"),
    strip.text.x = element_text(size = 12),
    # make gridlines dark, same contrast with white as in theme_grey
    panel.grid = element_line(colour = "grey92"),
    panel.grid.minor.y=element_line(colour = "grey92"),
    panel.grid.major.y=element_line(colour = "grey92"),
    # contour strips to match panel contour
    strip.background = element_rect(fill = "white", colour = "grey20"),
    # match legend key to background
    legend.key       = element_rect(fill = "white", colour = NA),
    complete = TRUE,
    ...
  )
}

#' @export 
format_si <- function(...) {
  # Based on code by Ben Tupper
  # https://stat.ethz.ch/pipermail/r-help/2012-January/299804.html
  
  function(x) {
    limits <- c(1e-24, 1e-21, 1e-18, 1e-15, 1e-12,
                1e-9,  1e-6,  1e-3,  1e0,   1e3,
                1e6,   1e9,   1e12,  1e15,  1e18,
                1e21,  1e24)
    prefix <- c("y",   "z",   "a",   "f",   "p",
                "n",   "?",   "m",   " ",   "k",
                "M",   "G",   "T",   "P",   "E",
                "Z",   "Y")
    
    # Vector with array indices according to position in intervals
    i <- findInterval(abs(x), limits)
    
    # Set prefix to " " for very small values < 1e-24
    i <- ifelse(i==0, which(limits == 1e0), i)
    
    paste(format(round(x/limits[i], 1),
                 trim=TRUE, scientific=FALSE, ...),
          prefix[i])
  }
}

#' @export 
percent <- function(x, digits = 1, format = "f", ...) {
  paste0(formatC(100 * x, format = format, digits = digits, ...), "%")
}



### A helper function to format lm_robust model output for further plotting

#' @export 
clean_cj_amce <- function(df = NULL, input = NULL) {
  
  box::use(stringr[str_extract], dplyr[...], data.table[setDT], tidyr[...])
  df  <- setDT(df)
  df <- df[term != "(Intercept)"]
  df$attribute <- (str_extract(df$term, "ATT[1-9]"))
  df$term <- gsub("ATT[1-9]", "", df$term)
  
  
  factors <- pivot_longer(input, ATT1:ATT9, names_to="attribute", values_to="term") %>% 
    select(term,attribute) %>% 
    distinct() %>% 
    arrange(attribute, term)
  
  
  df <- merge(df,factors,  by = c("attribute", "term"), all = TRUE)
  df[["estimate"]][is.na(df[["estimate"]])] <- 0
  df[estimate == 0, term := paste("(Baseline =", term, sep = " ")]
  df[estimate == 0, term := paste(term, ")", sep = "")]
  
  
  df <- df %>% 
    mutate(abs = abs(estimate)) %>% 
    group_by(attribute)  %>% 
    arrange(abs, .by_group = TRUE) %>% 
    ungroup() %>% 
    mutate(order = row_number()*-1) %>% 
    select(-abs)
  
  df$order <- factor(df$order) 
  
  
  df
}

